Pensieve header: Analysis of k=2 invariants in QU.

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\SL2Portfolio"];
<< KnotTheory`
<< "SL2PortfolioProgram.m"

OverbayP2Data=Get["C:\\drorbn\\AcademicPensieve\\People\\Overbay\\OverbayP2Data.m"];
OP2[K_Knot]:=K/.OverbayP2Data/.T->(T^(1/2));

Last[OverbayP2Data]

$p=5; $k=2; $U=QU;

SCθ[p_]:=Collect[ Cθ@(Subscript[𝕆, CU])[{y,a,x} ,p]/. {CU->Times, γ|ℏ->1}, ϵ, Simplify];
SQθ[p_]:=Collect[ Qθ@(Subscript[𝕆, QU])[{y,a,x} ,p]/. {QU->Times, γ|ℏ->1}, ϵ, Simplify];

(Subscript[𝔼[L_,Q_,P_], $k_]):=𝔼[L,Q,Series[Normal@P,{ϵ,0,$k}]];
(Subscript[(Subscript[𝔼, d_->r_])[L_,Q_,P_], $k_]):=(Subscript[𝔼, d->r])@@(Subscript[𝔼[L,Q,P], $k]);
𝔼3@𝔼[ω_,L_,Q_,Ps_]:=CF/@(Subscript[𝔼[L,(ω^(-1)) Q,(ω^(-1))((((ω^(-4))ϵ))^(-1+Range@Length@Ps)).Ps], $k]);
𝔼4@𝔼[L_,Q_,P_]:=Module[
{ω=((Normal[P])^(-1))/.ϵ->0,Ps=CoefficientList[P,ϵ]},
CF/@𝔼[ω,L,ω Q,(ω^(-3+4Range@Length@Ps))Ps]];
𝔼3@(Subscript[𝔼, sp___])[as___]:=𝔼3@𝔼[as]/.𝔼->(Subscript[𝔼, sp]);
𝔼4@(Subscript[𝔼, sp___])[as___]:=𝔼4@𝔼[as]/.𝔼->(Subscript[𝔼, sp]);

Clear[QP,ω];
QP[Knot[n_,k_]] := QP[Knot[n,k]]=Collect[Module[{fname},
fname="../SL2Invariant/k=2/Data/"<>ToString[n]<>"_"<>ToString[k]<>".m";
Collect[𝔼3[Get[fname][[2,2]]][[3]] // Normal, ϵ, Simplify]
], ϵ, CF];
ω[K_Knot]:=ω[K]=Factor[(((QP@K/.ϵ->0))^(-1))];
LQP[K_]:=Collect[Normal@Log[ω[K]QP[K]+((O[ϵ])^3)], ϵ,Simplify];
(Subscript[c, k_,d_])[K_Knot]:=Factor[SeriesCoefficient[LQP[K],{y,0,0}, {ϵ,0,k},{a,0,d}]((ω[K])^(1+k))]

H[p_]:=If[TrueQ@Simplify[p==(p/.T->1/T)],σ@@CoefficientList[Expand@Together[p]/.(T^(n_))/;n<0:>0,T], p];
H[p_]:=If[TrueQ@Simplify[p==(p/.T->1/T)],Style[Expand@Together[p]/.(T^(n_))/;n<0:>0, Background -> Yellow], p];
H[p_]:=If[TrueQ@Simplify[p==(p/.T->1/T)],Style[p, Background -> Yellow], p];

Total[Table[
Simplify[((Subscript[c, 0,0])[K]==0∧(Subscript[c, 1,1])[K]==2ω[K]T(∂_T)ω[K])],
{K,AllKnots[{3,8}]}]]

MatrixForm[Table[
H/@Factor/@{ω[K],(((Subscript[c, 1,1])[K])/(T-(T^(-1)))),p1=((T(-(Subscript[c, 1,0])[K]+ω[K]T(∂_T)ω[K]))/(((T-1))^2)),2ω[K](Subscript[c, 2,0])[K]-ω[K](Subscript[c, 2,1])[K]/2,2ω[K](Subscript[c, 2,0])[K],ω[K](Subscript[c, 2,1])[K]/2,(Subscript[c, 2,2])[K]/ω[K],OP2[K]},
{K,AllKnots[{3,7}]}
]]

MatrixForm[mat=Table[
{q1=ω[K],q2=((T(-(Subscript[c, 1,0])[K]+ω[K]T(∂_T)ω[K]))/(((T-1))^2)),(*((T(∂_T)ω[K])/(T-(T^(-1)))),T(∂_T)(T(∂_T)ω[K]),*)q3=-2(Subscript[c, 2,0])[K]+ω[K](Subscript[c, 2,1])[K],q4=ω[K](((Subscript[c, 2,1])[K]-ω[K](Subscript[c, 2,2])[K])/(-2T+2/T)),q5=((ω[K])^2)(Subscript[c, 2,2])[K]/2, q6=((ω[K])^2)((T(-(Subscript[c, 1,0])[K]+ω[K]T(∂_T)ω[K]))/(((T-1))^2))};
Times @@@Subsets[Together /@ {q1,q2,q3,q4,q5,q6}, 5] /. T->-1,
{K,AllKnots[{3,9}]}
]];
Dimensions[mat]
MatrixRank[mat]

MatrixForm[mat=Table[
{q1,q2,q3,q4,q5}=Together /@ {ω[K],((T(-(Subscript[c, 1,0])[K]+ω[K]T(∂_T)ω[K]))/(((T-1))^2)),(*((T(∂_T)ω[K])/(T-(T^(-1)))),T(∂_T)(T(∂_T)ω[K]),*)-2(Subscript[c, 2,0])[K]+ω[K](Subscript[c, 2,1])[K],ω[K](((Subscript[c, 2,1])[K]-ω[K](Subscript[c, 2,2])[K])/(-2T+2/T)),((ω[K])^2)(Subscript[c, 2,2])[K]/2};
Join@@Table[(q1^k){q2,q3,q4,q5},{k,0,5}] /. T->-1,
{K,AllKnots[{3,8}]}
]];
Dimensions[mat]
MatrixRank[mat]

NullSpace[mat].Join@@Table[(qq1^k){qq2,qq3,qq4,qq5},{k,0,5}]

Most/@(Join@@(Permutations/@(PadRight[#,6]& /@IntegerPartitions[3])))

MatrixForm[mat=Table[
vs=(Together /@ {ω[K],p1=((T(-(Subscript[c, 1,0])[K]+ω[K]T(∂_T)ω[K]))/(((T-1))^2)),((T(∂_T)p1)/(T-(T^(-1)))),((T(∂_T)ω[K])/(T-(T^(-1)))),T(∂_T)(T(∂_T)ω[K]),-2(Subscript[c, 2,0])[K]+ω[K](Subscript[c, 2,1])[K],ω[K](((Subscript[c, 2,1])[K]-ω[K](Subscript[c, 2,2])[K])/(-2T+2/T)),((ω[K])^2)(Subscript[c, 2,2])[K]/2(*,OP2[K]*)})/.T->22/7;
PS=Select[Most/@(Join@@(Permutations/@(PadRight[#,1+Length[vs]]& /@IntegerPartitions[4]))), (Total[#[[-3;;-1]]]==1∧#[[3]]+#[[5]]≤1)&];
Table[Times@@(((v/@Range@Length@vs))^ps),{ps,PS}] /. v[i_]:>vs[[i]],
{K,AllKnots[{3,9}]}
]];
Dimensions[mat]
MatrixRank[mat]

NullSpace[mat].Table[Times@@(((v/@Range@Length@vs))^ps),{ps,PS}]

$Path